home *** CD-ROM | disk | FTP | other *** search
Text File | 1988-08-16 | 33.1 KB | 1,284 lines |
- ; CN8XIC.A86
- ; I/O for ICL PC.
- ; STARTSYSDEP ; This is so:
- ; ; PIP LISTING=86KERMIT.LST[WSSTARTSYSDEP^ZQENDSYSDEP^Z]
- ; ; will work.
- ;
- ; **************************************************************************
- ;
- ; This is the i/o support module for the Honeywell MicroSystem Executive
- ; Running Concurrent CP/M (COS-86, FTOS)
- ;
- ; Mark J. Hewitt University of Birmingham, UK August 1985
- ;
- ; Port selection is provided between the V24 and TELEX ports. It is
- ; impractical to extend this to the PRINTER port because both the PRINTER
- ; and KEYBOARD are routed through the same interrupt vector, and the XIOS
- ; code explicitly enables interrupts. This means that if I hijack the
- ; OS interrupt with what I think is non-reentrant but safe code, and pass
- ; all the keyboard characters to the OS, when it returns, interrupts are
- ; enabled, and havoc follows. There are three solutions to this, for the
- ; brave of heart:
- ;
- ; a) Patch the STI instruction out of the OS image at runtime.
- ; b) Write the Kermit interrupt service routine to be fully re-entrant.
- ; c) Do not bother to provide support for the PRINTER port.
- ;
- ; I've chosen solution (c).
- ;
- ; The V.24 port uses the full V.24 standard, and it is therefore necessary
- ; to loop back the baud rate clock. This appears on pin 16 of the D-type
- ; connector. This should be connected to pins 15 and 17 for normal async.
- ; operation.
- ;
- ; A further limitation is that only one Kermit can be run at once, even
- ; though it would appear that two Kermits could be run concurrently to
- ; the two ports. This is because the ports share the same interrupt vector.
- ;
- ; **************************************************************************
- ;
- CSEG $
-
- ; Port base definitions
-
- comm equ 08000h ; Telex and V24 port i/o base (7201)
- bgen equ 0E000h ; Baud Rate Generator (8253-5)
- ictrl equ 0E400h ; Interrupt Controller (8259A)
-
- ; And the I/O ports themselves
-
- bgcmd equ bgen+6 ; Baud rate generator command port
-
- iccmd equ ictrl+0 ; Interrupt controller command port
- icmask equ ictrl+2 ; Interrupt controller mask register port
-
- tlxcmd equ comm+4 ; Telex command port
- tlxbg equ bgen+4 ; Baud rate countdown value for telex port
- tlxio equ comm+0 ; Telex data io port
-
- v24cmd equ comm+6 ; V24 command port
- v24bg equ bgen+2 ; Baud rate countdown value for v24 port
- v24io equ comm+2 ; V24 data io port
- ;
- ; Port selection
- ;
- ptlx equ 0 ; Telex port selected
- pv24 equ 1 ; V.24 port selected
-
- ;
- ; Interrupt vectors in page 0
- ;
- ivcomm equ 0100h ; 0:x interrupt vector for Telex and V.24
- ;
- ; Interrupt masks
- ;
- imcomm equ 01h ; mask for Telex/V.24 interrupts
- imnet equ 02h ; mask for network interrupt
- imfdc equ 04h ; mask for floppy disc controller interrupt
- imbus equ 08h ; mask for expansion bus interrupt
- imwdc equ 10h ; mask for winchester disc controller int.
- imxxx equ 20h ; not used
- imfrl equ 40h ; mask for frame reference latch interrupt
- imprt equ 80h ; mask for printer and keyboard interrupts
- ;
- ; Baud rate generator command words
- ;
- tlxbsel equ 0B6h ; select telex baud rate register
- v24bsel equ 76h ; select V.24 baud rate register
- ;
- ; Interrupt controller commands
- ;
- iceoi equ 20h ; end of interrupt
- ;
- ; I/O register bits
- ;
- ; For communications (Telex and V.24) ports
- ;
- ccreg0 equ 00h ; Control instruction - select register 0
- ccreg1 equ 01h ; Control instruction - select register 1
- ccreg2 equ 02h ; Control instruction - select register 2
- ccreg3 equ 03h ; Control instruction - select register 3
- ccreg4 equ 04h ; Control instruction - select register 4
- ccreg5 equ 05h ; Control instruction - select register 5
- ccreg6 equ 06h ; Control instruction - select register 6
- ccreg7 equ 07h ; Control instruction - select register 7
-
- c0null equ 00h ; Register 0 - null command
- c0abort equ 08h ; Register 0 - send abort
- c0resi equ 10h ; Register 0 - reset ext. status ints.
- c0chrst equ 18h ; Register 0 - channel reset
- c0eninc equ 20h ; Register 0 - enable int. on next character
- c0rpti equ 28h ; Register 0 - reset pending tx int./DMA req.
- c0errst equ 30h ; Register 0 - error reset
- c0eoi equ 38h ; Register 0 - end of interrupt
- c0rxcrc equ 40h ; Register 0 - reset rx CRC checker
- c0txcrc equ 80h ; Register 0 - reset tx CRC generator
- c0ricrc equ 0C0h ; Register 0 - reset idle/CRC latch
-
- c1stien equ 01h ; Register 1 - external/status int enable
- c1txien equ 02h ; Register 1 - transmitter interrupt enable
- c1cav equ 03h ; Register 1 - condition affects vector
- c1noi equ 00h ; Register 1 - no rx or DMA interrupts
- c1i1st equ 08h ; Register 1 - int. on 1st received character
- c1iall equ 10h ; Register 1 - int. on all received characters
- c1ialp equ 18h ; Register 1 - int on all rx'd chars, no parity
- c1wrxtx equ 20h ; Register 1 - WAIT on rx/tx
- c1txbcm equ 40h ; Register 1 - TX byte count mode enbable
- c1wten equ 80h ; Register 1 - WAIT function enable
- ;
- ; and some useful abbreviations
- ;
- c1norm equ c1ialp
- ;
- c2dma0 equ 00h ; Register 2 - No DMA
- c2dma1 equ 01h ; Register 2 - DMA mode 1
- c2dma2 equ 02h ; Register 2 - DMA mode 2
- c2dma3 equ 03h ; Register 2 - DMA mode 3
- c2pri equ 04h ; Register 2 - Set DMA priority
- c2ack0 equ 00h ; Register 2 - Int. Ack. mode 0 (NV,D432)
- c2ack1 equ 08h ; Register 2 - Int. Ack. mode 1 (NV, D432)
- c2ack2 equ 10h ; Register 2 - Int. Ack. mode 2 (NV, D210)
- c2ack4 equ 20h ; Register 2 - Int. Ack. mode 4 (8085 master)
- c2ack5 equ 28h ; Register 2 - Int. Ack. mode 5 (8085 slave)
- c2ack6 equ 30h ; Register 2 - Int. Ack. mode 6 (8086)
- c2ack7 equ 38h ; Register 2 - Int. Ack. mode 7 (8085/8259A slave)
- c2rxim equ 40h ; Register 2 - rx interrupt mask
- c2syncb equ 80h ; Register 2 - pin 10 ~RTSB or ~SYNCB
-
- c3rxen equ 01h ; Register 3 - receive enable
- c3scli equ 02h ; Register 3 - sync character load inhibit
- c3asm equ 04h ; Register 3 - address search mode
- c3rxcrc equ 08h ; Register 3 - receiver CRC enable
- c3hunt equ 10h ; Register 3 - enter hunt phase
- c3aen equ 20h ; Register 3 - auto enables on DCD/CTS
- c3r5bit equ 00h ; Register 3 - 5 bit data
- c3r6bit equ 40h ; Register 3 - 6 bit data
- c3r7bit equ 80h ; Register 3 - 7 bit data
- c3r8bit equ 0C0h ; Register 3 - 8 bit data
- ;
- ; and some useful abbreviations
- ;
- c3norm equ c3rxen+c3r8bit
- ;
- c4pen equ 01h ; Register 4 - parity enable
- c4ep equ 02h ; Register 4 - even parity
- c41stp equ 04h ; Register 4 - 1 stop bit
- c415stp equ 08h ; Register 4 - 1.5 stop bits
- c42stp equ 0C0h ; Register 4 - 2 stop bits
- c48syn equ 00h ; Register 4 - 8 bit internal sync (monosync)
- c416syn equ 10h ; Register 4 - 16 bit internal sync (bisync)
- c4sdlc equ 20h ; Register 4 - SDLC
- c4exts equ 30h ; Register 4 - External sync
- c41clk equ 00h ; Register 4 - 1x clock rate
- c416clk equ 40h ; Register 4 - 16x clock rate
- c432clk equ 80h ; Register 4 - 32x clock rate
- c464clk equ 0C0h ; Register 4 - 64x clock rate
- ;
- ; and some useful abbreviations
- ;
- c4norm equ c41stp+c416clk
- ;
- c5txcrc equ 01h ; Register 5 - transmitter CRC enable
- c5rts equ 02h ; Register 5 - request to send
- c5poly equ 04h ; Register 5 - CRC polynomial select
- c5txen equ 08h ; Register 5 - transmitter enable
- c5sbrk equ 10h ; Register 5 - send break
- c5t5bit equ 00h ; Register 5 - transmit 5 bit data
- c5t6bit equ 20h ; Register 5 - transmit 6 bit data
- c5t7bit equ 40h ; Register 5 - transmit 7 bit data
- c5t8bit equ 60h ; Register 5 - transmit 8 bit data
- c5dtr equ 80h ; Register 5 - data terminal ready
- ;
- ; and some useful abbreviations
- ;
- c5norm equ c5rts+c5txen+c5t8bit+c5dtr
- ;
- cs0rxr equ 01h ; Status register 0 - received char ready
- cs0ip equ 02h ; Status register 0 - interrupt pending
- cs0tbe equ 04h ; Status register 0 - tx buffer empty
- cs0dcd equ 08h ; Status register 0 - data carrier detect
- cs0sync equ 10h ; Status register 0 - sync status
- cs0cts equ 20h ; Status register 0 - clear to send
- cs0idle equ 40h ; Status register 0 - idle CRC latch status
- cs0brk equ 80h ; Status register 0 - break detect
-
- cs1sent equ 01h ; Status register 1 - all sent
- cs1sdlc equ 0Eh ; Status register 1 - SDLC residue code
- cs1pe equ 10h ; Status register 1 - parity error
- cs1oe equ 20h ; Status register 1 - overrun error
- cs1fe equ 40h ; Status register 1 - framing error
- cs1eosf equ 80h ; Status register 1 - end of SDLC frame
- ;
- ; System Calls
- ;
- p_dispatch equ 8Eh ; Reschedule in Concurrent CP/M
- f_errmode equ 2dh ; Set BDOS error mode
- p_pdadr equ 9Ch ; Get current process's descriptor (PD)
- s_sysdat equ 9Ah ; Get address of system data segment
- p_termcpm equ 0 ; return to Concurrent CP/M
- c_wrtstr equ 9 ; write a string to console
- ;
- ; Process management equates
- ;
- pnoff equ 8 ; offset of process name into PD
- pnlen equ 8 ; length of process name in PD
- pcns equ 20h ; offset to process console in PD
- thrdrt equ 72h ; Offset to thread list root in system data
- thread equ 2 ; Offset to thread list pointer in PD
- ;
- ; Clock rate *10 for timing loops ;[19g]
- ;
- clckrt equ 80 ;[19g] 8.0 Mhz
- ;
- ; Maximum number of examinations of output port to be ready before
- ; rescheduling.
- ;
- outlmt equ 1000h
-
- ;
- ; The executable code starts here
- ;
- ;
- ; ===========================================================================
- ;
- ; INITIALISATION ROUTINES
- ;
- ; ===========================================================================
- ;
- ; INTERFACE ROUTINE SERINI - Initialisation code
- ;
- serini: cmp mninit, true ; Ensure that we only initialise once
- je serin2
- mov mninit, true
- ;
- ; Now check that only one invokation of Kermit exists, and abort if we
- ; were not there first - too many frogs spoil the pond!
- ;
- call setname ; set my own process name
- call onlychk ; ensure we are the only Kermit
- ;
- ; Initialise the screen
- ;
- call toansi ; configure the screen in ANSI mode
- call clrscr ; clear the screen in ANSI mode.
- ;
- ; Disable I/O interrupts, and save the old interrupt mask.
- ; CGL - removed
- ; mov dx, icmask ; read the current interrupt mask
- ; in al, dx
- ; mov oldmsk, al ; and save it
- ; or al, imcomm ; mask off i/o interrupts
- ; out dx, al ; and reprogram interrupt controller
- ;
- ; Save the system i/o interrupt vectors
- ;
- ; mov ax, ds ; save the data segment in code segment
- ; mov cs:mndseg, ax ; for use by interrupt handler
-
- ; mov ax, 0 ; point to zero page and save both the
- ; mov es, ax ; system's i/o interrupt vectors
- ; mov ax,es:.ivcomm+0 ; for the V.24/Telex channel
- ; mov vscoff, ax
- ; mov ax, es:.ivcomm+2
- ; mov vscseg, ax
- ;
- ; Configure the default port
- ;
- ; CGL - removed
- ; mov ax, 0 ; point to zero page and set the interrupt
- ; mov es, ax ; vector for the V.24/Telex channel to my
- ; interrupt service routine
- ; mov ax, offset isr ; set offset address
- ; mov es:.ivcomm+0, ax
- ; mov ax, cs ; set segment address
- ; mov es:.ivcomm+2, ax
- ;
- ; call setmode ; set UART mode for current port
- ; call setbaud ; set the baud rate for the current port
- ; call mnflush ; flush and enable the current port
- ; call inton ; turn interrupts on for current port
- ;
- ; set BDOS error mode
- ;
- mov cl, f_errmode
- mov dl, 0FEh ; return and display mode
- int bdos
-
- serin2: ret ; initialisation over
- ;
- ; INTERNAL ROUTlNE SETNAME - set the name of my process
- ; This is to ensure that all invokations of
- ; Kermit have the same name, and thus we can
- ; make certain that only one is running.
- ;
- setname:mov cl, p_pdadr ; get the address of my process descriptor
- int bdos
- mov pd_seg, es ; and save it
- mov pd_off, ax
- add bx, pnoff ; offset into PD of process name field
- mov si, offset myname
- mov di, bx
- mov cx, pnlen ; length of process name
- cld
- rep movsb ; move the process name
- ret
- ;
- ; INTERNAL ROUTINE ONLYCHK - ensure that the current process is the only
- ; incarnation running. Only return if we are
- ; alone (In space, no-one can hear you scream)
- ;
- onlychk:pushf ; this must be done with interrupts off
- cli
- mov cl, s_sysdat ; get address of system data segment
- int bdos
- mov bx, es:word ptr thrdrt[bx] ; address of root of thread list
-
- ;
- ; Loop through the thread list, looking for processes with the same name
- ; and differently addressed process dcescriptors to the current one
- ;
- cld
- oc001: push bx
- push es
- mov si, offset myname ; compare the names
- add bx, pnoff ; point at name on thread list
- mov di, bx
- mov cl, pnlen
- repz cmpsb ; perform the comparison
- pop es ; restore regs - does not alter flags
- pop bx
- jz oc002 ; may be myself
- oc003: mov bx, es:word ptr thread[bx] ; next process on thread list
- cmp bx, 0 ; null terminated thread list
- jne oc001
- popf
- ret ; return through here if we are alone
-
- oc002: cmp bx, pd_off ; check if we have found ourselves
- jz oc003 ; we have - this is OK!
-
- mov dx, offset frogXn ; another kermit exists - abort
- mov cl, c_wrtstr ; ... prettily
- mov al, es:byte ptr pcns[bx] ; the console of other Kermit
- popf ; restore interrupt status
- add al, '0'
- mov okcons, al
- int bdos
- oc004: mov cl, p_termcpm ; and exit
- int bdos
- jmp oc004 ; just in case
-
- DSEG $ ; Data used for process management
-
- pd_seg rw 1 ; segment containing current process descriptor
- pd_off rw 1 ; offset of current process descriptor
- myname db 'Lineuser' ; Name that current process will be known by
- frogXn db 'Another Lineuser is running on console '
- okcons db 1 ; console of other kermit
- db cr, lf, '$'
-
- CSEG $
-
- ;
- ; INTERFACE ROUTINE SERFIN - restore environment (as far as possible)
- ; to that which existed before we played with it
- ;
- serfin: cmp mninit, true ; only deinitialise if necessary
- jmp serfn2 ; CGL
- mov mninit, false
- ;
- ; Disable i/o interrupt while we reset the vectors
- ;
- mov dx, icmask ; get present interrupt mask
- in al, dx ; and turn off all i/o interrupts
- or al, imcomm ; from the V.24/Telex channel
- out dx, al ; reprogram the interrupt controller
- ;
- ; Reset the i/o interrupt vectors
- ;
- mov ax, 0 ; point at page 0 and reset the int. vectors
- mov es, ax
- mov ax, vscoff ; for the V.24/Telex port
- mov es:.ivcomm+0, ax
- mov ax, vscseg
- mov es:.ivcomm+2, ax
- ;
- ; turn interrupts back on (or off...)
- ;
- mov al, oldmsk ; restore original interrupt mask
- out dx, al
- ;
- ; Reset screen modes
- ;
- call clrscr ; be tidy - clear the screen
- call toft ; reset screen to FT mode
-
- serfn2: ret ; deinitialisation over
-
- ;
- ; INTERNAL ROUTINE TOANSI - configure screen in ANSI mode
- ;
- toansi: ret ; CGL
- mov dx, offset ansion
- call tmsg
- ret
- ;
- ; INTERNAL ROUTINE TOFT - configure screen in FT mode
- ;
- toft: ret ; CGL
- mov dx, offset fton
- call tmsg
- ret
- ;
- ; INTERNAL ROUTINE SETMODE - set the operating mode for current port's UART.
- ; Port number in cport,
- ; Current UART command port in ccmdp.
- ;
- setmode: ret ; CGL
- push ax
- push dx ; we'll need this
-
- mov dx, ccmdp ; current command port for UART
-
- cmp cport, ptlx ; is it the Telex port?
- je smcomm
- cmp cport, pv24 ; is it the V.24 port?
- jne setmo2 ; must be an error - just return for now
-
- smcomm: ; set UART modes for the Telex/V.24 port
- mov al, c0chrst ; reset the port
- out dx, al
- mov al, c0resi+ccreg4 ; select register 4
- out dx, al
- mov al, c4norm ; 16x Clock, 1 stop bit, no parity
- out dx, al
- mov al, c0resi+ccreg3 ; Select register 3
- out dx, al
- mov al, c3norm ; 8 bits/character, RX enable
- out dx, al
- mov al, c0resi+ccreg5 ; select register 5
- out dx, al
- mov al, c5norm ; 8 bits/character, TX enable RTS and DTR
- out dx, al
- mov al, c0resi+ccreg1 ; select register 1
- out dx, al
- mov al, c1norm ; Interrupt enable
- out dx, al
-
- setmo2: pop dx ; modes now set, restore regs. and return
- pop ax
- ret
-
- ;
- ; INTERNAL ROUTINE SETBAUD - set the baud rate of a current port.
- ; port number in cport.
- ; timer countdown table offset in cbaud.
- ;
- setbaud: ret ; CGL
- push bx ; we'll be using this
- push dx ; and this
- push ax ; and this too
-
- mov al, bdtab ; check that rate is legal
- dec al ; pick up number of valid rates from BDTAB
- cmp cbaud, al ; 0 <= cbaud <= [bdtab]-1
- ja setbd2 ; just return if not legal
-
- mov bx, offset bdtct ; get timer value
- mov al, cbaud ; from timer countdown table
- mov ah, 0
- add al, al ; word offset
- add bx, ax ; bx now points to correct value
-
- mov dx, bgcmd ; dx is now baud rate generator command port
-
- cmp cport, ptlx ; is it the telex port?
- je sbtlx
- cmp cport, pv24 ; is it the v24 port?
- jne setbd2 ; just return if not
-
- mov al, v24bsel ; set baud rate for v24 port
- out dx, al
- mov dx, v24bg
- jmp setbd3
-
- sbtlx: mov al, tlxbsel ; set baud rate for telex port
- out dx, al
- mov dx, tlxbg
-
- setbd3: mov ax, [bx] ; set the countdown value
- out dx, al
- mov al, ah
- out dx, al
-
- setbd2: pop ax ; baud rate set, retore regs. and return
- pop dx
- pop bx
- ret
-
- ;
- ; INTERNAL ROUTINE MNFLUSH - enable and flush current port.
- ; Port in cport.
- ;
- mnflush: ret ; CGL
- push ax ; preserve registers
- push dx
-
- mov dx, ciop ; current io port
- in al, dx ; flush the port
- in al, dx
- in al, dx
- mov dx, ccmdp ; reset any pending interrupts
- mov al, c0errst
- out dx, al
- mov al, c0resi
- out dx, al
-
- pop dx ; port flushed, retore regs. and return
- pop ax
- ret
-
- ;
- ; INTERNAL ROUTINE INTON - enable interrupts for the selected port
- ; Port number in cport.
- ; Ensure that the port selected is enabled, and
- ; that all other ports are as the system would
- ; wish them!
- inton: ret ; CGL
- push ax
- push dx
-
- mov dx, icmask
- mov al, oldmsk ; Disable i/o interrupts from the V24/Telex
- or al, imcomm ; channel.
- out dx, al
-
- cmp cport, ptlx ; is it the Telex port?
- je ietlx
- cmp cport, pv24 ; is it the V.24 port?
- jne inton2 ; must be an error - just return for now
-
- mov dx, tlxcmd ; disable ints from Telex port
- jmp iecomm
-
- ietlx: mov dx, v24cmd ; disable ints from V.24 port
-
- iecomm: mov al, c0resi+ccreg1
- out dx, al
- mov al, c1norm and not c1ialp
- out dx, al
-
- mov dx, icmask
- and al, not imcomm ; enable Telex and V.24 interrupts
- out dx, al
-
- inton2: pop dx
- pop ax ; interrupts now enabled - restore regs.
- ret ; and return
-
- DSEG $ ; Data used by initialisation/deinitialisation
-
- mninit db false ; flag set when initialised
- oldmsk rb 1 ; Old interrupt mask
- ;
- ; Screen mode control strings
- ;
- ansion db esc, '[$' ; enter ANSI mode
- fton db esc, 'Q$' ; re-enter FT mode
- ;
- ; Current port status
- ;
- cport db ptlx ; current port number - default to TELEX
- cbaud db 8 ; current baud rate - default to 4800
- ciop dw tlxio ; current i/o port - default to TELEX
- ccmdp dw tlxcmd ; current command/status port - default TELEX
- ;
- ; Storage for system interrupt vectors
- ;
- vscoff rw 1 ; offset for system v.24/telex int. vector
- vscseg rw 1 ; seg. address for system v.24/telex int. vec
- ;
- ; Baud rate timer countdown table
- ;
- bdtct dw 769 ; 50 baud, code 0, +0.03% error
- dw 513 ; 75 1 -0.04%
- dw 350 ; 110 2 -0.10%
- dw 256 ; 150 3 +0.16%
- dw 128 ; 300 4 +0.16%
- dw 64 ; 600 5 +0.16%
- dw 32 ; 1200 6 +0.16%
- dw 16 ; 2400 7 +0.16%
- dw 8 ; 4800 8 +0.16%
- dw 4 ; 9600 9 +0.16%
- dw 2 ; 19200 10 +0.16%
-
- CSEG $
-
- ; ===========================================================================
- ;
- ; SET COMMANDS
- ;
- ; ===========================================================================
- ;
- ; INTERFACE ROUTINE BDSET - set baud rate for current port (cport).
- ; save current baud rate in cbaud.
- ;
- bdset: mov dx, offset bdtab ; table of valid baud rates
- mov bx, offset bdhlp ; help information for SET BAUD
- mov ah, cmkey ; Command parser - KEYWORD lookup
- call comnd
- jmp r ; error return
- mov settmp, bx ; Normal return - save value
- mov ah, cmcfm ; Command parser - CONFIRM
- call comnd
- jmp r
- mov bx, settmp
- mov cbaud, bl ; save the baud rate
- call setbaud ; and set it for the current port
- jmp rskp ; end of parsing SET BAUD command
-
- DSEG $
-
- settmp rw 1 ; temporary storage for baud rate
-
- CSEG $
- ;
- ; INTERFACE ROUTINE PRTSET - set the current port.
- ;
- prtset: jmp rskp ; CGL
- mov dx, offset potab ; table of valid port names
- mov bx, offset pohlp ; help information for SET PORT
- mov ah, cmkey ; Command parser - KEYWORD lookup
- call comnd
- jmp r ; error return
-
- mov settmp, bx ; Normal return - save value
-
- mov ah, cmcfm ; Command parser - CONFIRM
- call comnd
- jmp r
- ;
- ; Now we can do the work - first preset a few registers
- ;
- mov bx, settmp ; restore port number
- mov dx, ccmdp ; current command port
- mov al, c0resi+ccreg1 ; and command to select register 1
- ;
- ; establish which port we are to use
- ;
- cmp bl, ptlx ; is it the Telex port?
- je settlx
- cmp bl, pv24 ; is it the V.24 port?
- je setv24
- jmp r ; must've been an error
- ;
- ; Set the current port to be the V.24 connector
- ;
- setv24: out dx, al ; disable interrupts from current port
- mov al, c1norm and not c1ialp
- out dx, al
- mov ciop, v24io ; Set V.24 port
- mov ccmdp, v24cmd
- jmp prtdoit
- ;
- ; Set the current port to be the Telex port
- ;
- settlx: out dx, al ; disable interrupts from current port
- mov al, c1norm and not c1ialp
- out dx, al
- mov ciop, tlxio ; Set Telex port
- mov ccmdp, tlxcmd
- ;
- ; and actually configure it
- ;
- prtdoit:mov cport, bl ; save the current port
- call setmode ; configure the selected UART
- call setbaud ; set the port's baud rate
- call mnflush ; flush it
- call inton ; and enable interrupts for it
- jmp rskp ; end of parsing SET PORT command
- ;
- ; Data required by the SET commands
- ;
- DSEG $ ; SET command data
- ;
- ; Baud rate table
- ;
- bdtab db 11 ; number of entries
- db 3, '110$' ; size of entry, and the keyword$
- dw 02 ; value returned
- db 3, '150$'
- dw 03
- db 4, '1200$'
- dw 06
- db 5, '19200$'
- dw 10
- db 4, '2400$'
- dw 07
- db 3, '300$'
- dw 04
- db 4, '4800$'
- dw 8
- db 2, '50$'
- dw 00
- db 3, '600$'
- dw 05
- db 2, '75$'
- dw 01
- db 4, '9600$'
- dw 09
- ;
- ; Help table for baud rate setting
- ;
- bdhlp db cr, lf, ' 50 75 110 150 300 600'
- db cr, lf, ' 1200 2400 4800 9600 19200'
- db '$'
- ;
- ; Port table
- ;
- potab db 2
- db 5, 'AUX $'
- dw ptlx
- db 3, 'AUX$'
- dw pv24
- ;
- ; Help table for port selection
- ;
- pohlp db cr, lf, 'AUX $'
-
- CSEG $
-
- ; ===========================================================================
- ;
- ; SHOW COMMANDS
- ;
- ; ===========================================================================
-
- ;
- ; INTERFACE ROUTINE SHOBD - display the currently set baud rate within
- ; the SHOW command.
- ;
- shobd: mov dx, offset bdst ;Baud rate string.
- call tcrmsg
- mov al, cbaud ;Print the keyword corresponding to the
- mov bx, offset bdtab; current value of mnbaud.
- call tabprt
- ret
-
- ;
- ; INTERFACE ROUTINE SHOPRT - display the currently selected communication
- ; port within the SHOW command.
- ;
- shoprt: mov dx, offset prtst ; Port name string
- call tcrmsg
- mov al, cport ; current port code
- mov bx, offset potab ; and print the corresponding
- call tabprt ; textual description
- mov dx, offset prtst2
- call tmsg
- ret
-
- DSEG $
-
- prtst db 'Communicating via $'
- prtst2 db ' port$'
-
- CSEG $
-
- ; ===========================================================================
- ;
- ; I/O ROUTINES
- ;
- ; ===========================================================================
- ;
- ; INTERNAL ROUTINE ISR - Interrupt service routine for Printer, Keyboard,
- ; Telex and V.24 ports.
- ;
- isr: cli ; disable intrerupts
- mov cs:mnax, ax ; save ax - we will need a register
- mov ax, sp
- mov cs:mnsp, ax ; save current stack pointer
- mov ax, ss
- mov cs:mnsseg, ax ; Save current stack segment
- mov ax, cs:mndseg ; Switch to my stack
- mov ss, ax
- mov sp, offset mnstk
- push ds ; Save registers
- push es
- push bp
- push di
- push si
- push dx
- push cx
- push bx
- mov ds, ax ; set our data segment address
- ;
- ; That's the housekeeping out of the way - now we can start
- ;
- mov dx, ccmdp ; see if char. ready at default port
- in al, dx
- test al, cs0rxr ; is there a character for us?
- jz iprt3 ; no - clear interrupt, and return
-
- iprt2: mov dx, ciop ; fetch the character
- in al, dx
- call iproc ; process the character in AL
-
- iprt3: mov dx, iccmd ; signal end of interrupt to
- mov al, iceoi ; interrupt controller
- out dx, al
-
- mov dx, tlxcmd ; Clear interrupt status at telex/v.24
- mov al, c0eoi ; channel.
- out dx, al ; note we use the Telex (A) channel
-
- pop bx ; restore registers
- pop cx
- pop dx
- pop si
- pop di
- pop bp
- pop es
- pop ds
- mov ax, cs:mnsp ; restore interrupt stack
- mov sp, ax
- mov ax, cs:mnsseg ; restore original stack segment
- mov ss, ax
- mov ax, cs:mnax ; restore original AX
- iret ; all over - return
-
- ;
- ; CSEG data required by interrupt service routine
- ;
- mnax dw 0 ; temp. copy of AX
- mnsp dw 0 ; interrupt stack pointer
- mnsseg dw 0 ; interrupt stack segment
- mndseg dw 0 ; location of our data segment
-
- ;
- ; INTERNAL ROUTINE IPROC - process incoming character from Rx interrupt
- ; Character in AL
- ;
-
- iproc:
- call cglin
- cmp cglfin, true
- jne ipr1a
- ret
- ipr1a:
- cmp floctl, floxon ;are we doing flow-control ? [19a] start
- jne ipr2b ;no - go on
- cmp al, xoff ;is it an XOFF?
- jne ipr2a ;no - go on
- mov xofrcv, true ;set the flag
- ret
-
- ipr2a: cmp al, xon ;an XON?
- jne ipr2b ;no
- mov xofrcv, false ;clear the flag
- ret ; [19a] end
-
- ipr2b: cmp mnchrn,mnchnd ;Is the buffer full?
- je iperr ;If so, take care of the error.
- inc mnchrn ;Increment the character count.
- mov bx,mnchip ;Get the buffer input pointer.
- inc bx ;Increment it.
- cmp bx,offset mnchrs+mnchnd ;Past the end?
- jb ipro3
- mov bx, offset mnchrs ;Yes, point to the start again.
- ipro3: mov mnchip,bx ;Save the pointer.
- mov [bx],al ;Put the character in the buffer.
- cmp floctl, floxon ;do flow-control? [19a] start
- je ipro4 ;If yes jump
- ret
-
- ipro4: cmp xofsnt, true ;Have we sent an XOFF
- jnz ipro5
- ret ;return if we have
-
- ipro5: cmp mnchrn, mntrg2 ;Past the High trigger point?
- ja ipro6 ;yes - jump
- ret
-
- ipro6: mov al, xoff
- call prtout ;send an XOFF
- mov xofsnt, true ;set the flag
- ret ; [19a] End
-
- iperr: ret ; just return on error for now
-
- ;
- ; INTERFACE ROUTINE CFIBF - Clear serial port input buffer
- ;
- cfibf: mov mnchrn, 0 ;Say no characters in the buffer.
- mov mnchip, OFFSET mnchrs-1+mnchnd ;Reset input pointer.
- mov mnchop, OFFSET mnchrs-1+mnchnd ;Reset output pointer.
- ret
-
- ;
- ; INTERFACE ROUTINE PRTOUT - send character in AL to current port.
- ;
- prtout:
- call dopar
- push dx
- push cx
- mov cx, outlmt
- prtou2:
- call outwait
- loop prtou2
- nop
- call outchr
- pop cx
- pop dx
- ret
-
- ; mov cl,al
- ; prout2:
- ; mov al,19
- ; call xios
- ; or al,al
- ; jnz prout3
- ; call dispatch
- ; jmp prout2
- ; prout3:
- ; mov al,6
- ; call xios
- ; pop cx
- ; pop dx
- ; ret
- ; INTERNAL ROUTINE XIOS (CGL)
- ;
- ; INTERNAL ROUTINE OUTWAIT - test if port ready for next char to be sent.
- ; returns RSKP if ready.
- ;
- outwait:
- cmp floctl, floxon
- jne outwt1
- cmp xofrcv, true
- je outwt3
- outwt1: push ax
- mov al, 19
- push bx
- call xios
- pop bx
- or al,al
- jnz outwt4
- pop ax
- outwt3: call dispatch
- ret
- outwt4: pop ax
- jmp rskp
- ;
- ; INTERNAL ROUTINE OUTCHR - send data to a port
- ;
- outchr:
- mov cl,al
- mov al, 6
- push bx
- call xios
- pop bx
- ret
-
- ;
- ; INTERFACE ROUTINE INSTAT - determine if there is any data to receive.
- ;
- instat:
- cmp mnchrn, 0
- jne inst2
- ; call dispatch
- mov cglfin, false
- inst1:
- cmp cglfin, true
- je inst3
- push bx
- call iproc
- pop bx
- jmp inst1
- inst2:
- jmp rskp
- inst3: cmp mnchrn, 0
- jne inst2
- ret
-
- ;
- ; INTERFACE ROUTINE INCHR - read a character from a port
- ;
- inchr:
- push bx
- cli ; Disable interrupts while were are playing.
- dec mnchrn ;Decrement the number of chars in the buffer.
- mov bx,mnchop ;Get the pointer into the buffer.
- inc bx ;Increment to the next char.
- cmp bx,offset mnchrs+mnchnd ;Past the end?
- jb inchr2
- mov bx, offset mnchrs ;If so wrap around to the start.
- inchr2: mov mnchop,bx ;Save the updated pointer.
- mov al,[bx] ;Get the character.
- sti ; All done, we can restore interrupts.
- pop bx
- cmp parflg,parnon ;[par] no parity?
- je inchr3 ;[par] yup, don't bother stripping
- and al,7fh ;[par] checking parity, strip off
- inchr3: cmp floctl, floxon ;do flow-control? [19a] start
- je inchr4 ;If yes jump
- ret
- inchr4: cmp xofsnt, true ;Have we sent an XOFF
- je inchr5 ;Jump if yes
- ret
- inchr5: cmp mnchrn, mntrg1 ;Under the low trigger point?
- jb inchr6 ;yes - jump
- ret
- inchr6: push ax ;save current character
- mov al, xon
- call prtout ;send an XON
- mov xofsnt, false ;turn off the flag
- pop ax ;get back character
- ret ; [19a] end
- cglin:
- push bx
- mov al,18
- call xios
- or al,al
- jz cgli2
- mov al,5
- call xios
- pop bx
- ret
- cgli2:
- mov cglfin, true
- pop bx
- ret ; [19a] end
- ; internals CGL
- get_sys_ptrs_:
- push es
- push ds
- mov cl,09ch
- int 224
- pop ds
- mov bx,ax
- mov bx,es:010h[bx]
- mov uda_segment,bx
- mov pda_offset,ax
- mov ax,es
- mov pda_segment,ax
- push ds
- mov cl,09ah
- int 224
- pop ds
- mov sysdat_offset,ax
- mov ax,es
- mov sysdat_segment,ax
- pop es
- mov ax,offset data_pointer
- ret
- xios:
- mov bx,sysdat_segment
- or bx,bx
- jz do_get_sys_ptrs
- push ds ! push es
- push bx
- mov bx,uda_segment
- mov es,bx
- mov bx,sysdat_offset
- pop ds
- callf dword ptr 28h[bx]
- pop es ! pop ds
- ret
- do_get_sys_ptrs:
- push ax ! push cx ! push dx
- call get_sys_ptrs_
- pop dx ! pop cx ! pop ax
- jmp xios
- data_pointer:
- sysdat_segment dw 0
- sysdat_offset dw 0
- pda_segment dw 0
- pda_offset dw 0
- uda_segment dw 0
- ;
- ; INTERFACE ROUTINE PRTBRK - Send a BREAK sequence to the default port
- ;
- prtbrk: ret ; CGL
- mov dx, ccmdp ; current command port
- cmp cport, ptlx ; is it TELEX port?
- je brkc
- cmp cport, pv24 ; is it V.24 port?
- jne brka ; must be an error - just return
-
- brkc:
- mov al, c0resi+ccreg5 ; break to telex/v24 ports
- out dx, al ; select register 5
- mov al, c5norm+c5sbrk ; 8 bits, TX enable, Break, RTS & DTR
- out dx, al
- mov ax, 275 ; for 275 mS
- call mswait
- mov al, c0resi+ccreg5 ; select register 5
- out dx, al
- mov al, c5norm ; 8 bits, TX enable, RTS & DTR
- out dx, al
- ret
-
- brka: ret
-
- DSEG $
- ;
- ; Input character queue
- ;
- mnchnd equ 512 ;Size of circular buffer.
- mnchrs rb mnchnd ;Circular character buffer for input.
- mnchip dw mnchrs-1+mnchnd ;Input pointer into character buffer.
- mnchop dw mnchrs-1+mnchnd ;Output pointer into character buffer.
- mnchrn dw 0 ;Number of chars in the buffer.
-
- mntrg1 equ 128 ;[19a] Low trigger point for Auto XON/XOFF
- mntrg2 equ 384 ;[19a] High trigger point for Auto XON/XOFF
-
- floctl db 1 ;[19a] If floctl=floxon do Auto XON/XOFF logic
- xofsnt db 0 ;[19a] set if XOFF was sent
- xofrcv db 0 ;[19a] set if XOFF was recieved
- cglfin db 0 ; set if no more chars on aux input
- ;
- ; a small stack for interrupt handling
- ;
- rw 64 ;Interrupt stack ;[28e]
- mnstk dw 0 ;bottom of stack ;[28e]
-
- CSEG $
-
- ; ===========================================================================
- ;
- ; UTILITY ROUTINES
- ;
- ; ===========================================================================
- ;
- ; INTERNAL ROUTINE MSWAIT - Delay for AL milliseconds
- ;
- mswait: ; [34] start
- mov cx,5*clckrt ; inner loop count for 1 millisec.
- mswai1:
- sub cx,1 ;** inner loop takes 20 clock cycles
- jnz mswai1 ;**
- dec ax ; outer loop counter
- jnz mswait ; wait another millisecond
- ret ; [34] end
-
- ;
- ; INTERNAL ROUTINE DISPATCH: Reschedule current process
- ;
- dispatch:
- push ax
- push bx
- push cx
- mov cl, p_dispatch
- int bdos
- pop cx
- pop bx
- pop ax
- ret
-
-
-
- ; ===========================================================================
- ;
- ; SCREEN CONTROL ROUTINES
- ;
- ; ===========================================================================
- ;
- ; INTERFACE ROUTINE POSCUR - positions cursor to row and col (each 1 byte)
- ; pointed to by dx.
- ;
-
- poscur: mov bx, dx ;Do ANSI cursor positioning.
- mov al, [bx] ;Get row value
- add al, ' '
- mov byte ptr anspos+2, al
- mov al, 1[bx] ;Do same for column value
- add al, ' '
- mov byte ptr anspos+3, al
- mov dx, offset anspos ;Print cursor positioning string.
- call tmsg
- ret
-
- ;
- ; INTERFACE ROUTINE CLRSCR - homes cursor and clears screen.
- ;
-
- clrscr: mov dx, offset anscls
- call tmsg
- ret
- ;
- ; INTERFACE ROUTINE CLRLIN - clears line.
- ;
-
- clrlin: mov dl, cr ;Go to beginning of line
- call bout
- ;
- ; ...FALL THROUGH
- ;
- ; INTERFACE ROUTINE CLREOL - clear to end of line
- ;
-
- clreol: mov dx, offset ansclr ;Clear from cursor to end of line
- call tmsg
- ret
-
- ;
- ; INTERFACE ROUTINE REVON - turns on reverse video display
- ;
-
- revon: mov dx, offset ansron
- call tmsg
- ret
-
- ;
- ; INTERFACE ROUTINE REVOFF - turns off reverse video display
- ;
-
- revoff: mov dx, offset ansrof
- call tmsg
- ret
- ;
- ; INTERFACE ROUTINE BLDON - turns on bold (highlighted) display
- ;
-
- bldon: mov dx, offset ansbon
- call tmsg
- ret
- ;
- ; INTERFACE ROUTINE BLDOFF - turns off bold (highlighted) display
- ;
-
- bldoff: mov dx, offset ansbof
- call tmsg
- ret
-
-
- DSEG $
-
- anspos db esc,'=xy$' ;Position cursor to row and column
- anscls db esc, '+$' ;Home cursor and clear screen
- ansclr db esc, 'T$' ;Clear from cursor to end of line
- ansron db esc, '[4ZZ$' ;Turn on reverse video
- ansrof db esc, '[0ZZ$' ;Turn off reverse video
- ansbon db esc, '[8ZZ$' ; Bold on
- ansbof db esc, '[0ZZ$' ; Bold off
-
- CSEG $
- ;
- ; INTERFACE ROUTINE DOTAB - do tab expansion if necessary
- ;
- dotab: jmp rskp ; assume h/w does it for now
-
- ;
- ; Assorted textual constants required as part of the machine interface
- ;
- DSEG $
-
- delstr db 10O,'$' ;Delete string.
- system db ' ICL Personal Computer Concurrent$'
-
- CSEG $
- ;
- ; ENDSYSDEP
- ;
-